unit frmRun; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, process, FileUtil, LResources, Forms, Controls, Graphics,
  Dialogs, StdCtrls, Grids, ExtCtrls, ActnList, Buttons, Menus, ComCtrls,
  DCPmd5, frmEditor;

type

  { TRunForm }

  TRunForm = class(TForm)
    actnRun: TAction;
    actnDeleteScript: TAction;
    actnDeleteVariable: TAction;
    actnNewScript: TAction;
    actnSaveScript: TAction;
    actnSaveScriptAs: TAction;
    actnNewVariable: TAction;
    btnRun: TBitBtn;
    Images: TImageList;
    MainMenu: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem8: TMenuItem;
    MenuItem9: TMenuItem;
    RunActions: TActionList;
    cbxScriptnames: TComboBox;
    Label1: TLabel;
    lbVariables: TListBox;
    Script: TMemo;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    procedure actnDeleteVariableExecute(Sender: TObject);
    procedure actnNewScriptExecute(Sender: TObject);
    procedure actnNewVariableExecute(Sender: TObject);
    procedure actnRunExecute(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure cbxScriptnamesChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lbVariablesClick(Sender: TObject);
    procedure lbVariablesDblClick(Sender: TObject);
    procedure VariablesClick(Sender: TObject);
  private
    FEditor: TEditorFrame;
    FVariables: TStringList;
    procedure SetEditor(const AValue: TEditorFrame);
    procedure ShowVariables;
    procedure RunScript;
  public
    property Editor: TEditorFrame read FEditor write SetEditor;
  end; 

var
  RunForm: TRunForm;

implementation

uses dmMain, md5;

{ TRunForm }

procedure TRunForm.FormCreate(Sender: TObject);
begin
  FEditor := nil;
  FVariables := TStringList.Create;
  cbxScriptnames.Items.Text := dataMain.GetApplicationSetting('Run/Scripts', '');
  if cbxScriptnames.Items.Count > 0 then
    cbxScriptnames.ItemIndex := 0;
end;

procedure TRunForm.btnCloseClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TRunForm.cbxScriptnamesChange(Sender: TObject);
begin
  actnSaveScript.Enabled := cbxScriptnames.ItemIndex > -1;
  actnDeleteScript.Enabled := cbxScriptnames.ItemIndex > -1;
end;

procedure TRunForm.actnRunExecute(Sender: TObject);
begin
  RunScript;
  dataMain.SetApplicationSetting('Run/' + Editor.Language + '/Variables', FVariables.Text);
end;

procedure TRunForm.actnNewScriptExecute(Sender: TObject);
begin
  cbxScriptnames.ItemIndex := -1;
  Script.Lines.Clear;
end;

procedure TRunForm.actnNewVariableExecute(Sender: TObject);
  var N, V: String;
begin
  N := Trim(InputBox('Create variable', 'Enter a name for the new variable (without preceding "$"):', 'myVariable'));
  if (N = '') then Exit;
  V := InputBox('Enter value', 'Enter the value for "$' + N + '":', '');
  FVariables.Values[N] := V;
  ShowVariables;
end;

procedure TRunForm.actnDeleteVariableExecute(Sender: TObject);
begin
  if lbVariables.ItemIndex > -1 then
  begin
    FVariables.Delete(lbVariables.ItemIndex);
    ShowVariables;
    actnDeleteVariable.Enabled := lbVariables.ItemIndex > -1;
  end;
end;

procedure TRunForm.FormDestroy(Sender: TObject);
begin
  FVariables.Free;
end;

procedure TRunForm.lbVariablesClick(Sender: TObject);
begin
  actnDeleteVariable.Enabled := lbVariables.ItemIndex > -1;
end;

procedure TRunForm.lbVariablesDblClick(Sender: TObject);
var VarName, VarValue: String;
begin
  if lbVariables.ItemIndex = -1 then Exit;
  lbVariables.Items.GetNameValue(lbVariables.ItemIndex, VarName, VarValue);
  FVariables.Values[VarName] := InputBox('Enter value', 'Enter a new value for the variable $' + VarName, VarValue);
  ShowVariables;
end;

procedure TRunForm.VariablesClick(Sender: TObject);
begin
  ShowVariables;
end;

procedure TRunForm.SetEditor(const AValue: TEditorFrame);
begin
  FEditor := AValue;
  if not Assigned(FEditor) then Exit;
  if (FEditor.Filename = '') then
  begin
    MessageDlg('Cannot run', 'The file is not saved. You must save the file before running an external script.', mtError, [mbClose], 0);
    Close;
  end;
  // First load all the variables
  FVariables.Text := dataMain.GetApplicationSetting('Run/' + Editor.Language + '/Variables', '');
  FVariables.Values['path'] := ExtractFilePath(FEditor.Filename);
  FVariables.Values['file'] := ChangeFileExt(ExtractFileName(FEditor.Filename), '');
  FVariables.Values['ext'] := Copy(ExtractFileExt(FEditor.Filename), 2, Length(FEditor.Filename));
  ShowVariables;
end;

procedure TRunForm.ShowVariables;
begin
  lbVariables.Clear;
  lbVariables.Items.Text := FVariables.Text;
  actnDeleteVariable.Enabled := lbVariables.ItemIndex > -1;
end;

procedure TRunForm.RunScript;
var i: Integer;
    s: String;
    RunInBackground: Boolean;
    WatchFile, VariableForPID: String;
    OldMD5, NewMD5: TMD5Digest;
    MaxRepeat, Repeats: Integer;
    ExitStatus: Integer;
    Process: TProcess;
    // Replace all $variables in the string by the values from FVariables
    function ReplaceVariables(const AString: String): String;
    var j: Integer;
        n, v: String;
    begin
      Result := AString;
      for j := 0 to FVariables.Count - 1 do
      begin
        FVariables.GetNameValue(j, n, v);
        Result := StringReplace(Result, '$' + n, v, [rfReplaceAll]);
      end;
    end;
    // Handles the common commands
    function ExtractWord(var AString: String): String;
    begin
      Result := Trim(Copy(AString, 1, Pos(' ', AString + ' ')));
      Delete(AString, 1, Length(Result) + 1);
    end;
    function HandleCommand(var AString: String): Boolean;
    var Command: String;
    begin
      Result := False;
      if Copy(AString, 1, 1) <> '@' then Exit;
      Command := ExtractWord(AString);
      // @ifset var: sets the rest of the string to '' if $var is undefined
      if CompareText(Command, '@ifset') = 0 then
      begin
        Result := True;
        if FVariables.IndexOfName(ExtractWord(s)) = -1 then
          s := '';
        Exit;
      end;
      // @background flags the command to run in the background
      if CompareText(Command, '@background') = 0 then
      begin
        Result := True;
        RunInBackground := True;
        Exit;
      end;
      // @watching file: keep running until "file" stops changing
      //  (use with @repeat is strongly recommended)
      if CompareText(Command, '@repeat') = 0 then
      begin
        Result := True;
        MaxRepeat := StrToInt(ExtractWord(AString));
        if MaxRepeat < 1 then MaxRepeat := 1;
        Exit;
      end;
      // @watching file: keep running for max runs or until "file" stops changing
      if CompareText(Command, '@watching') = 0 then
      begin
        Result := True;
        WatchFile := ExtractWord(AString);
        Exit;
      end;
      // @storePID var will store the PID of the created process in $var
      //  will be ignored unless @background is set
      if CompareText(Command, '@storepid') = 0 then
      begin
        Result := True;
        VariableForPID := ExtractWord(AString);
        Exit;
      end;
      // @close pid: will close the process with ID (pid) when it is ours
      if CompareText(Command, '@close') = 0 then
      begin
        Result := True;
        dataMain.CloseProcess(StrToInt(ExtractWord(AString)));
        Exit;
      end;
    end;
begin
  if not Assigned(FEditor) then Exit;
  Hide;
  FEditor.ClearLog;
  FEditor.Log('Starting script at ' + DateToStr(Now));
  for i := 0 to Script.Lines.Count - 1 do
  begin
    s := Trim(ReplaceVariables(Script.Lines[i]));
    FEditor.Log('Line ' + IntToStr(i + 1) + ': ' + s);
    // Reset state variables
    RunInBackground := False;
    WatchFile := '';
    MaxRepeat := 1;
    VariableForPID := '';
    // If the line still starts with an '@', process the command
    while HandleCommand(s) do;
    if s = '' then
      Continue;

    // Cannot repeat or watch in background mode
    if RunInBackground and ((WatchFile <> '') or (MaxRepeat > 1)) then
    begin
      FEditor.Log('Warning: @background process cannot be @watched and/or @repeat-ed.');
      WatchFile := '';
      MaxRepeat := 1;
    end;
    // Also, can only store PID for background process
    if (not RunInBackground) and (VariableForPID <> '') then
    begin
      FEditor.Log('Warning: Can only @storePID for @background processes.');
      VariableForPID := '';
    end;
    // If watching, calculate the MD5
    OldMD5 := MD5String('');
    if WatchFile <> '' then
      NewMD5 := MD5File(WatchFile);
    // Create the process
    Process := TProcess.Create(dataMain);
    Process.CommandLine := s;
    FEditor.Log('Running "' + s + '"');
    // Register background process, or indicate that we want to wait for it to finish
    if RunInBackground then
      dataMain.RegisterProcess(Process)
    else
      Process.Options := [poWaitOnExit];
    // Run the process as long as the watchfile has changed (if appropriate),
    // ánd the maximum number of runs has not been reached
    Repeats := 1;
    while ((WatchFile = '') or (not MD5Match(OldMD5, NewMD5))) and (Repeats <= MaxRepeat) do
    begin
      FEditor.Log('  > Run #' + IntToStr(Repeats));
      Process.Execute;
      if not RunInBackground then ExitStatus := Process.ExitStatus;
      if (WatchFile <> '') then
      begin
        OldMD5 := NewMD5;
        NewMD5 := MD5File(WatchFile);
        FEditor.Log(' MD5 changed from ' + MD5Print(OldMD5) + ' to ' + MD5Print(NewMD5));
      end;
      Inc(Repeats);
    end;
    // If storage of its PID was requested, do so (if it is a background process, that is)
    if (VariableForPID <> '') then
        FVariables.Values[VariableForPID] := IntToStr(Process.ProcessID);
    // If it is not a background process, get the exit code and free process
    if not RunInBackground then
    begin
      Process.Free;
      // Check exit code, bail out if it is non-zero
      if ExitStatus <> 0 then
      begin
        FEditor.Log('The command "' + s + '" returned non-zero exit code ' + IntToStr(ExitStatus));
        ModalResult := mrNo;
      end;
    end;
    ModalResult := mrYes;
    FEditor.FinishLog;
  end;
end;

initialization
  {$I frmRun.lrs}

end.

